home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
gnu
/
smaltalk.lha
/
smalltalk-1.1.1
/
CompiledMethod.st
< prev
next >
Wrap
Text File
|
1991-09-12
|
17KB
|
588 lines
"======================================================================
|
| CompiledMethod Method Definitions
|
======================================================================"
"======================================================================
|
| Copyright (C) 1990, 1991 Free Software Foundation, Inc.
| Written by Steve Byrne.
|
| This file is part of GNU Smalltalk.
|
| GNU Smalltalk is free software; you can redistribute it and/or modify it
| under the terms of the GNU General Public License as published by the Free
| Software Foundation; either version 1, or (at your option) any later version.
|
| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
| details.
|
| You should have received a copy of the GNU General Public License along with
| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
| Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
======================================================================"
"
| Change Log
| ============================================================================
| Author Date Change
| sbyrne 27 Dec 89 Added real print method for compiled methods.
|
| sbyrne 6 Sep 89 Added lots of methods: inspect, =, hash, method
| cateogry, methodSourceCode, methodSourceString, and
| some private accessors such as bytecodeAt:.
|
| sbyrne 25 Apr 89 created.
|
"
ArrayedCollection variableByteSubclass: #CompiledMethod
instanceVariableNames: 'descriptor methodHeader'
classVariableNames: ''
poolDictionaries: ''
category: nil.
CompiledMethod comment:
'I represent methods that have been compiled. I can recompile
methods from their source code, I can invoke Emacs to edit the source code
for one of my instances, and I know how to access components of my
instances.' !
"Make sure that this symbol is defined, even if it doesn't work just
yet."
Smalltalk at: #Debugger put: nil!
!CompiledMethod methodsFor: 'basic'!
methodCategory
^descriptor category
!
methodCategory: aCategory
^descriptor category: aCategory
!
methodSourceCode
^descriptor sourceCode
!
methodSourceString
^descriptor sourceString
!
methodSourceFile
^descriptor sourceFile
!
methodSourcePos
^descriptor sourcePos
!
= aMethod
descriptor = aMethod getDescriptor ifFalse: [ ^false ].
methodHeader = aMethod getHeader ifFalse: [ ^false ].
1 to: self numLiterals do:
[ :i | (self literalAt: i) = (aMethod literalAt: i)
ifFalse: [ ^false ] ].
1 to: self numBytecodes do:
[ :i | (self bytecodeAt: i) = (aMethod bytecodeAt: i)
ifFalse: [ ^false ] ].
^true
!
hash
| hashValue |
hashValue _ descriptor hash.
hashValue _ ((hashValue bitShift: 1)
bitXor: methodHeader hash)
bitAnd: 16r1FFFFFFF.
1 to: self numLiterals do:
[ :i | hashValue _ ((hashValue bitShift: 1)
bitXor: (self literalAt: i) hash)
bitAnd: 16r1FFFFFFF ].
1 to: self numBytecodes do:
[ :i | hashValue _ ((hashValue bitShift: 1)
bitXor: (self bytecodeAt: i) hash)
bitAnd: 16r1FFFFFFF ].
^hashValue
!!
!CompiledMethod methodsFor: 'method header accessors'!
"The structure of a method header is as follows (from mstinterp.h)
3 2 1
1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|1|.|.|.|.|.|flg| prim index | #args | #temps | #literals |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
literals 6 0..5
temporarycount 5 6..10
args 5 11..15
primitiveIndex 8 16..23
flags 2 24-25
flags 0 -- use arguments as they are, ignore prim index
flags 1 -- return self
flags 2 -- return instance variable
flags 3 -- call the primitive indexed by primIndex
"
flags
^(methodHeader bitShift: -24) bitAnd: 16r3
!
primitive
^(methodHeader bitShift: -16) bitAnd: 16rFF
!
numArgs
| flags |
flags _ self flags.
(flags = 2) | (flags = 3)
ifTrue: [ ^0 ].
^(methodHeader bitShift: -11) bitAnd: 16r1F
!
numTemps
self flags = 0
ifFalse: [ ^0 ].
^(methodHeader bitShift: -6) bitAnd: 16r1F
!
numLiterals
self flags = 0
ifFalse: [ ^0 ].
^methodHeader bitAnd: 16r3F
!!
!CompiledMethod methodsFor: 'copying'!
shallowCopy
^(CompiledMethod newMethod: self basicSize
header: methodHeader) shallowCopyMethodContents: self
!
deepCopy
^(CompiledMethod newMethod: self basicSize
header: methodHeader) deepCopyMethodContents: self
!!
!CompiledMethod methodsFor: 'debugging'!
inspect
| class instVars |
class _ self class.
instVars _ class instVarNames.
'An instance of ' print.
class printNl.
1 to: (instVars size - 1) do: "assumes methodHeader is last inst var"
[ :i | ' ' print.
(instVars at: i) print.
': ' print.
(self objectAt: i) printNl ].
' Header Flags: ' printNl.
' flags: ' print.
self flags printNl.
' primitive index: ' print.
self primitive printNl.
' number of arguments: ' print.
self numArgs printNl.
' number of temporaries: ' print.
self numTemps printNl.
' number of literals: ' print.
self numLiterals printNl.
self numLiterals > 0
ifTrue: [ ' literals: [' printNl.
1 to: self numLiterals do:
[ :i | ' ' print.
i print.
': ' print.
(self literalAt: i) storeNl ].
' ]' printNl ]
!!
!CompiledMethod methodsFor: 'debugging'!
breakpointAt: byteIndex
"self notYetImplemented"
Debugger recordOldByte: (self bytecodeAt: byteIndex)
atIndex: byteIndex
forMethod: self.
self bytecodeAt: byteIndex put: Debugger debugByte
!
breakAtLine: lineNumber
self notYetImplemented
!
removeBreakpointAt: byteIndex
| oldByte |
oldByte _ Debugger origByteAt: byteIndex forMethod: self.
oldByte notNil
ifTrue: [ self bytecodeAt: byteIndex put: oldByte ]
!!
!CompiledMethod methodsFor: 'printing'!
printOn: aStream
"### This could be more interesting, such as calling the decompiler, or
printing out the byte codes, or ... yeah, yeah, that's it, the byte
codes...also need to decode the header information to display that
interesting information"
| primIndex numLits |
true
ifTrue: [ 'a CompiledMethod' printOn: aStream. ]
ifFalse:
[ 'Header Info: ' printOn: aStream.
(primIndex _ self primitive) > 0
ifTrue: [ 'Primitive: ' printOn: aStream ].
numLits _ self numLiterals.
' # Args: ' printOn: aStream.
(self numArgs) printOn: aStream.
' # Temps: ' printOn: aStream.
(self numTemps) printOn: aStream.
' # Literals: ' printOn: aStream.
numLits printOn: aStream. aStream nl.
numLits > 0
ifTrue: [ 'Literals' printOn: aStream. aStream nl.
'--------' printOn: aStream. aStream nl.
1 to: numLits do:
[ :i | ' [' printOn: aStream.
i printOn: aStream.
']: ' printOn: aStream.
(self literalAt: i) storeOn: aStream.
aStream nl ] ].
" Emit header info here too "
'Byte codes' printOn: aStream. aStream nl.
'----------' printOn: aStream. aStream nl.
self printByteCodesOn: aStream ]
!
storeOn: aStream
self printOn: aStream
!!
!CompiledMethod methodsFor: 'private'!
shallowCopyMethodContents: aMethod
"Don't need to copy the method header; it's already done"
descriptor _ aMethod getDescriptor.
1 to: aMethod numLiterals do:
[ :i | self literalAt: i put: (aMethod literalAt: i) ].
1 to: aMethod numBytecodes do:
[ :i | self bytecodeAt: i put: (aMethod bytecodeAt: i) ]
!
deepCopyMethodContents: aMethod
"Don't need to copy the method header; it's already done"
descriptor _ aMethod getDescriptor deepCopy.
1 to: aMethod numLiterals do:
[ :i | self literalAt: i put: (aMethod literalAt: i) deepCopy ].
1 to: aMethod numBytecodes do:
[ :i | self bytecodeAt: i put: (aMethod bytecodeAt: i) ]
!
printByteCodesOn: aStream
| numBytes i |
i _ 1.
numBytes _ self numBytecodes.
[ i <= numBytes ] whileTrue:
[ i _ i + (self printByteAt: i on: aStream) ]
!
printByteAt: anIndex on: aStream
| byte nextByte skip |
byte _ self bytecodeAt: anIndex.
byte == 127 "Debugger debugByte"
ifTrue: [ byte _ Debugger origByteAt: anIndex forMethod: self ].
skip _ 1.
' [' printOn: aStream.
anIndex printOn: aStream.
']: ' printOn: aStream.
byte < 95 ifTrue:
[ self printIndexedAt: anIndex on: aStream ].
(byte between: 96 and: 111) ifTrue:
[ self emitSimplePop: byte on: aStream ].
(byte between: 112 and: 125) ifTrue:
[ self emitBuiltin: byte on: aStream ].
"127 is the debugger breakpoint and we don't get it here"
byte == 128 ifTrue:
[ skip _ 2.
self print2BytePush: (self bytecodeAt: anIndex + 1) on: aStream ].
byte == 129 ifTrue:
[ skip _ 2.
self print2ByteStackOp: 'store' at: anIndex on: aStream ].
byte == 130 ifTrue:
[ skip _ 2.
self print2ByteStackOp: 'pop and store' at: anIndex on: aStream ].
(byte between: 131 and: 134) ifTrue:
[ skip _ self emitIndexedSend: anIndex on: aStream ].
byte == 135 ifTrue:
[ 'pop stack top ' printOn: aStream ].
byte == 136 ifTrue:
[ 'duplicate stack top' printOn: aStream ].
byte == 137 ifTrue:
[ 'push current context' printOn: aStream ].
(byte between: 138 and: 143) ifTrue:
[ 'ILLEGAL bytecode ' printOn: aStream.
byte printOn: aStream ].
(byte between: 144 and: 175) ifTrue:
[ skip _ self printJump: anIndex on: aStream ].
(byte between: 176 and: 191) ifTrue:
[ 'send arithmetic message "' printOn: aStream.
(#(+ - < >
<= >= = ~=
* / \\ @
bitShift: // bitAnd: bitOr:)
at: (byte bitAnd: 15) + 1) printOn: aStream.
'"' printOn: aStream ].
(byte between: 192 and: 207) ifTrue:
[ 'send special message "' printOn: aStream.
(#(at: at:put: size next
nextPut: atEnd == class
blockCopy: value value: do:
new new: x y)
at: (byte bitAnd: 15) + 1) printOn: aStream.
'"' printOn: aStream ].
(byte between: 208 and: 255) ifTrue:
[ self printSmallArgSend: byte on: aStream ].
aStream nextPut: (Character nl).
^skip
!
printIndexedAt: anIndex on: aStream
| byte index |
byte _ self bytecodeAt: anIndex.
byte <= 15 ifTrue:
[ ^self pushIndexed: 'Instance Variable'
withIndex: (byte bitAnd: 15)
on: aStream ].
byte <= 31 ifTrue:
[ ^self pushIndexed: 'Temporary'
withIndex: (byte bitAnd: 15)
on: aStream ].
byte <= 63 ifTrue:
[ ^self pushIndexed: 'Literal'
withIndex: (byte bitAnd: 31)
on: aStream ].
" >= 64 case here "
'push Global Variable[' printOn: aStream.
(byte bitAnd: 31) printOn: aStream.
'] = ' printOn: aStream.
self printAssociationKeyFor: (byte bitAnd: 31) on: aStream
!
pushIndexed: indexLabel withIndex: anIndex on: aStream
'push ' printOn: aStream.
indexLabel printOn: aStream.
'[' printOn: aStream.
anIndex printOn: aStream.
']' printOn: aStream
!
emitSimplePop: byte on: aStream
(byte between: 96 and: 103) ifTrue:
[ aStream nextPutAll: 'pop and store instance variable['.
(byte bitAnd: 7) printOn: aStream.
aStream nextPut: $] ].
(byte between: 104 and: 111) ifTrue:
[ aStream nextPutAll: 'pop and store Temporary['.
(byte bitAnd: 7) printOn: aStream.
aStream nextPut: $] ].
!
emitBuiltin: byte on: aStream
byte == 112 ifTrue: [ 'push self' printOn: aStream ].
byte == 113 ifTrue: [ 'push true' printOn: aStream ].
byte == 114 ifTrue: [ 'push false' printOn: aStream ].
byte == 115 ifTrue: [ 'push nil' printOn: aStream ].
byte == 116 ifTrue: [ 'push -1' printOn: aStream ].
byte == 117 ifTrue: [ 'push 0' printOn: aStream ].
byte == 118 ifTrue: [ 'push 1' printOn: aStream ].
byte == 119 ifTrue: [ 'push 2' printOn: aStream ].
byte == 120 ifTrue: [ 'return self' printOn: aStream ].
byte == 121 ifTrue: [ 'return true' printOn: aStream ].
byte == 122 ifTrue: [ 'return false' printOn: aStream ].
byte == 123 ifTrue: [ 'return nil' printOn: aStream ].
byte == 124 ifTrue: [ 'return Message stack top' printOn: aStream ].
byte == 125 ifTrue: [ 'return Block stack top' printOn: aStream ].
byte == 126 ifTrue: [ '### ILLEGAL BYTE CODE 126 ###' printOn: aStream ].
!
print2BytePush: byte on: aStream
self printIndexedPush: (byte bitAnd: 63)
type: (byte bitShift: -6)
on: aStream
!
printIndexedPush: index type: typeIndex on: aStream
| typeName |
typeName _ self indexedLocationName: typeIndex.
'push ' , typeName , '[' printOn: aStream.
index printOn: aStream.
']' printOn: aStream.
typeIndex = 3 ifTrue:
[ ' = ' printOn: aStream.
self printAssociationKeyFor: index
on: aStream ]
!
indexedLocationName: locIndex
^#('Instance Variable' 'Temporary' 'Literal' 'Global Variable')
at: locIndex + 1
!
print2ByteStackOp: opName at: anIndex on: aStream
| nextByte locationName locIndex |
nextByte _ self bytecodeAt: anIndex + 1.
locIndex _ nextByte bitShift: -6.
locationName _ self indexedLocationName: locIndex.
locIndex == 2 ifTrue: [ 'ILLEGAL ' printOn: aStream ].
opName , locationName , '[' printOn: aStream.
(nextByte bitAnd: 63) printOn: aStream.
']' printOn: aStream.
locIndex == 3 ifTrue:
[ ' = ' printOn: aStream.
self printAssociationKeyFor: (nextByte bitAnd: 63) on: aStream ]
!
emitIndexedSend: anIndex on: aStream
| byte byte1 byte2 toSuper |
byte _ self bytecodeAt: anIndex.
byte _ byte - 131. "transform to 0..3"
byte <= 1 ifTrue: [ toSuper _ '' ]
ifFalse: [ toSuper _ 'to Super ' ].
(byte == 0) | (byte == 2)
ifTrue:
[ byte1 _ self bytecodeAt: anIndex + 1.
self emitGenericSend: toSuper index: (byte1 bitAnd: 31)
args: (byte1 bitShift: -5) on: aStream.
^2 ]
ifFalse:
[ byte1 _ self bytecodeAt: anIndex + 1.
byte2 _ self bytecodeAt: anIndex + 2.
self emitGenericSend: toSuper index: byte2
args: byte1 on: aStream.
^3]
!
emitGenericSend: toSuper index: anIndex args: numArgs on: aStream
'send ' , toSuper , 'selector ' printOn: aStream.
anIndex printOn: aStream.
', ' printOn: aStream.
numArgs printOn: aStream.
' args = ' printOn: aStream.
self printLiteralSymbolAt: anIndex on: aStream
!
printJump: anIndex on: aStream
| byte |
byte _ self bytecodeAt: anIndex.
byte <= 151 ifTrue:
[ 'jump to ' printOn: aStream.
((byte bitAnd: 7) + anIndex + 1 + 1 ) printOn: aStream.
^1 ].
byte <= 159 ifTrue:
[ 'jump to ' printOn: aStream.
((byte bitAnd: 7) + anIndex + 1 + 1 ) printOn: aStream.
' if false' printOn: aStream.
^1 ].
byte <= 167 ifTrue:
[ 'jump to ' printOn: aStream.
(((byte bitAnd: 7) - 4) * 256 + (self bytecodeAt: anIndex + 1)
+ anIndex + 2) printOn: aStream.
^2 ].
byte <= 171 ifTrue:
[ 'pop and jump to ' printOn: aStream.
((byte bitAnd: 3) * 256 + (self bytecodeAt: anIndex + 1)
+ anIndex + 2) printOn: aStream.
' if true' printOn: aStream.
^2 ].
byte <= 175 ifTrue:
[ 'pop and jump to ' printOn: aStream.
((byte bitAnd: 3) * 256 + (self bytecodeAt: anIndex + 1)
+ anIndex + 2) printOn: aStream.
' if false' printOn: aStream.
^2 ]
!
printSmallArgSend: byte on: aStream
| numArgs |
byte _ byte - 208.
numArgs _ byte // 16.
'send selector ' printOn: aStream.
(byte bitAnd: 15) printOn: aStream.
', ' printOn: aStream.
numArgs printOn: aStream.
numArgs == 1
ifTrue: [ ' arg' printOn: aStream ]
ifFalse: [ ' args' printOn: aStream ].
' = ' printOn: aStream.
self printLiteralSymbolAt: (byte bitAnd: 15) on: aStream
!
printAssociationKeyFor: anIndex on: aStream
| assoc |
assoc _ self literalAt: anIndex + 1.
assoc key printOn: aStream
!
printLiteralSymbolAt: anIndex on: aStream
(self literalAt: anIndex + 1) printOn: aStream
!
getDescriptor
^descriptor
!
getHeader
^methodHeader
!
literalAt: anIndex
^self objectAt: (anIndex + 2)
!
literalAt: anInteger put: aValue
self objectAt: anInteger + 2 put: aValue
!
numBytecodes
^(self basicSize) - (self bytecodeStart)
!
bytecodeAt: anIndex
^self basicAt: (anIndex + self bytecodeStart)
!
bytecodeAt: anIndex put: aValue
^self basicAt: (anIndex + self bytecodeStart) put: aValue
!
bytecodeStart
^4 * self numLiterals
!!